CD Ware Multimedia 1995 May/cd Ware (Juegos) Epimundo.iso/DOS/PRGMMING/M2PROTOS.ZIP/QCPROTO.MOD

Modula Implementation | 1993-12-26 | 6.1 KB | 191 lines

(*# call(o_a_copy => off) *)
(*%F _fdata *)
(*# call(seg_name => null) *)
(*%E *)
(*# module(implementation=>on) *)
(*# data(seg_name => null) *)
(*# data(const_assign => on) *)
IMPLEMENTATION MODULE QCproto;

                     (* This JPI Modula-2 module is part of *)

                      (* QC -- a communications program *)
                             (* by Carl Neiburger *)
                              (* 169 N. 25th St.*)
                          (* San Jose, Calif. 95116 *)

                         (* CompuServe No. 72336,2257 *)

FROM PathFind IMPORT FileTree, UnFileTree, FilePtr, ParsePath;
FROM Str IMPORT Append, CHARSET, Compare, Concat, Delete, Length, Pos;
FROM QCdisp IMPORT PressKey, PromptForString, QCDef, QCDefPtr, Kermit, BPlus,
     XModem, XModem1K, ZModem, Yes, ProtoNames;
FROM QCkermit IMPORT ReceiveKermit, SendKermit;
FROM QCxm IMPORT SimpleXmProtos, ReceiveXmodem, SendXmodem;
FROM QCzm IMPORT ReceiveZmodem, SendZmodem;
IMPORT NFIO;
FROM Storage IMPORT DEALLOCATE;

VAR
    FilePath, FileName, GetFiles : NFIO.PathStr;
    dummy : ARRAY [0..66] OF CHAR;

PROCEDURE ChoosePath(VAR Name: NFIO.PathStr);
(* Chooses download path if it exists and no other path is specified *)
BEGIN
    IF (QCDefPtr^.DLpath[0] = 0C)
      OR (Pos(Name, '\') # MAX(CARDINAL))
      OR (Pos(Name, ':') # MAX(CARDINAL))
      THEN
         RETURN
    END; (* Use default directory *)
    FilePath := QCDefPtr^.DLpath;
    IF NOT (FilePath[Length(FilePath)-1] IN CHARSET{':','\'}) THEN
         Append(FilePath, '\')
    END;
    Concat(Name, FilePath, Name)
END ChoosePath;

PROCEDURE GetFileName;
VAR  OK: BOOLEAN;
BEGIN
   FilePath := '';
   OK := FALSE;
   REPEAT
      IF PromptForString('File to receive (Return to abort): ', FileName) THEN
         ChoosePath (FileName); (* DIAG: TENTATIVE FIX *)
         IF NFIO.Exists(FileName) THEN
               Concat( dummy, FileName, ' Exists. OK to overwrite it?');
               OK := Yes (dummy);
         ELSE
            OK := TRUE
         END
      END
   UNTIL OK OR (FileName[0] = 0C );
END GetFileName;

PROCEDURE GetPath;
BEGIN
    FileName[0] := 0C;
    FilePath := QCDefPtr^.DLpath;
    IF (FilePath[0] = 0C) AND NOT PromptForString(
'Directory to put file in ("." for current; Return to abort):', FilePath ) THEN
         RETURN
    END;
    LOOP
         IF ParsePath( FilePath, NFIO.PathTail(FileName) ) THEN
              IF NOT (FilePath[Length(FilePath)-1] IN CHARSET{':','\'}) THEN
                   Append(FilePath, '\')
              END;
              FileName[0] := 0C;
              RETURN
         ELSIF NOT
            PromptForString(
            'Directory was not valid. Enter directory (Return for current): ',
              FilePath ) THEN
              RETURN
         END
    END
END GetPath;

PROCEDURE ReceiveProtocol;
BEGIN
    CASE QCDefPtr^.Protocol OF
         BPlus : RETURN;
        |XModem, XModem1K:
              GetFileName;
              IF FileName[0] = 0C THEN
                   PressKey('Transfer aborted.');
                   RETURN
              END
         ELSE
              GetPath;
              IF FilePath[0] = 0C THEN
                   PressKey('Transfer aborted.');
                   RETURN
              END
    END;
    IF QCDefPtr^.Protocol = Kermit THEN
         IF PromptForString(
              'If connected to "server," files to GET; Otherwise Return: ',
         GetFiles ) THEN END;
         ReceiveKermit( FilePath, GetFiles )
    ELSE
         IF (QCDefPtr^.Protocol IN SimpleXmProtos) AND (FileName[0] = 0C) THEN
              RETURN
         END;
         IF QCDefPtr^.Protocol = ZModem THEN
              ReceiveZmodem( FilePath );
         ELSE
              ReceiveXmodem( FilePath, FileName )
         END
    END;
END ReceiveProtocol;

PROCEDURE SendProtocol;
VAR FileList, ThisFile, ThatFile, TempFile: FilePtr;
    BatchFile : NFIO.File;
BEGIN
    CASE QCDefPtr^.Protocol OF
         BPlus : RETURN;
        |XModem, XModem1K:
              dummy := 'Enter file to send or Return to abort: '
         ELSE
dummy := 'Enter file(s) to send or "/" + batch list file or Return to abort: '
    END;
    IF NOT PromptForString(dummy, FileName) THEN
         RETURN
    END;
    IF FileName[0] = '/' THEN
         Delete(FileName, 0, 1);
         BatchFile := NFIO.Open(FileName);
         IF BatchFile = MAX(CARDINAL) THEN
              Concat(dummy, 'Cannot find ', FileName);
              PressKey(dummy);
              RETURN
         END;
         FileList := NIL;
         WHILE NOT NFIO.EOF(BatchFile) DO
              NFIO.RdStr(BatchFile, FileName);
              IF FileName[0] <> 0C THEN
                   IF FileList = NIL THEN
                        FileList := FileTree ( FileName );
                        ThisFile := FileList;
                   ELSE
                        ThisFile^.Next := FileTree ( FileName );
                   END;
                   WHILE (ThisFile <> NIL) AND (ThisFile^.Next <> NIL) DO
                        ThisFile := ThisFile^.Next
                   END
              END
         END;
         NFIO.Close(BatchFile);
         WHILE ThisFile^.Next <> NIL DO (* delete any duplicates *)
              ThatFile := ThisFile;
              WHILE ThatFile^.Next <> NIL DO
                   IF Compare(ThisFile^.Name, ThatFile^.Next^.Name) = 0 THEN
                        TempFile := ThatFile^.Next;
                        ThatFile^.Next := TempFile^.Next;
                        DISPOSE(TempFile)
                   ELSE
                        ThatFile := ThatFile^.Next
                   END;
              END;
              ThisFile := ThisFile^.Next
         END
    ELSE
         FileList := FileTree ( FileName )
    END;
    IF FileList <> NIL THEN
         CASE QCDefPtr^.Protocol OF
              Kermit : SendKermit( FileList );
             |ZModem : SendZmodem( FileList )
                 |ELSE SendXmodem( FileList )
         END;
         UnFileTree( FileList )
    ELSE
         PressKey('No matching files');
    END
END SendProtocol;

END QCproto.